home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / PPI / Util.pm < prev    next >
Encoding:
Perl POD Document  |  2010-07-06  |  2.0 KB  |  78 lines
  1. package PPI::Util;
  2.  
  3. # Provides some common utility functions that can be imported
  4.  
  5. use strict;
  6. use Exporter     ();
  7. use Digest::MD5  ();
  8. use Params::Util qw{_INSTANCE _SCALAR0 _ARRAY0};
  9.  
  10. use vars qw{$VERSION @ISA @EXPORT_OK};
  11. BEGIN {
  12.     $VERSION   = '1.213';
  13.     @ISA       = 'Exporter';
  14.     @EXPORT_OK = qw{_Document _slurp};
  15. }
  16.  
  17. # Alarms are used to catch unexpectedly slow and complex documents
  18. use constant HAVE_ALARM   => !  ( $^O eq 'MSWin32' or $^O eq 'cygwin' );
  19.  
  20. # 5.8.7 was the first version to resolve the notorious
  21. # "unicode length caching" bug. See RT #FIXME
  22. use constant HAVE_UNICODE => !! ( $] >= 5.008007 );
  23.  
  24. # Common reusable true and false functions
  25. # This makes it easy to upgrade many places in PPI::XS
  26. sub TRUE  () { 1  }
  27. sub FALSE () { '' }
  28.  
  29.  
  30.  
  31.  
  32.  
  33. #####################################################################
  34. # Functions
  35.  
  36. # Allows a sub that takes a L<PPI::Document> to handle the full range
  37. # of different things, including file names, SCALAR source, etc.
  38. sub _Document {
  39.     shift if @_ > 1;
  40.     return undef unless defined $_[0];
  41.     require PPI::Document;
  42.     return PPI::Document->new(shift) unless ref $_[0];
  43.     return PPI::Document->new(shift) if _SCALAR0($_[0]);
  44.     return PPI::Document->new(shift) if _ARRAY0($_[0]);
  45.     return shift if _INSTANCE($_[0], 'PPI::Document');
  46.     return undef;
  47. }
  48.  
  49. # Provide a simple _slurp implementation
  50. sub _slurp {
  51.     my $file = shift;
  52.     local $/ = undef;
  53.     local *FILE;
  54.     open( FILE, '<', $file ) or return "open($file) failed: $!";
  55.     my $source = <FILE>;
  56.     close( FILE ) or return "close($file) failed: $!";
  57.     return \$source;
  58. }
  59.  
  60. # Provides a version of Digest::MD5's md5hex that explicitly
  61. # works on the unix-newlined version of the content.
  62. sub md5hex {
  63.     my $string = shift;
  64.     $string =~ s/(?:\015{1,2}\012|\015|\012)/\015/gs;
  65.     Digest::MD5::md5_hex($string);
  66. }
  67.  
  68. # As above but slurps and calculates the id for a file by name
  69. sub md5hex_file {
  70.     my $file    = shift;
  71.     my $content = _slurp($file);
  72.     return undef unless ref $content;
  73.     $$content =~ s/(?:\015{1,2}\012|\015|\012)/\n/gs;
  74.     md5hex($$content);
  75. }
  76.  
  77. 1;
  78.